Lendo os dados

resultados_avaliacoes_exp01 = read_avaliacoes()
## Parsed with column specification:
## cols(
##   id = col_character(),
##   item = col_character(),
##   municipio = col_character(),
##   criterio = col_character(),
##   aproach = col_character(),
##   date = col_datetime(format = ""),
##   valid = col_logical(),
##   contNodeNumberAccess = col_double(),
##   found = col_logical(),
##   pathSought = col_character(),
##   durationMin = col_double(),
##   duration = col_double(),
##   tipo_exp = col_character()
## )
resultados_avaliacoes_exp01[is.na(resultados_avaliacoes_exp01)] <- ""

gararito = read_gabaritos()
## Parsed with column specification:
## cols(
##   municipio = col_character(),
##   criterio = col_character(),
##   item = col_character(),
##   encontrado = col_logical(),
##   local_encontrado = col_character(),
##   local_encontrado_2 = col_character()
## )
gararito[is.na(gararito)] <- ""

empresas_portais <- readr::read_csv(here::here("data/empresas_portais.csv"))
## Warning: Missing column names filled in: 'X8' [8], 'X9' [9], 'X10' [10],
## 'X11' [11], 'X12' [12], 'X13' [13], 'X14' [14], 'X15' [15], 'X16' [16],
## 'X17' [17], 'X18' [18]
## Parsed with column specification:
## cols(
##   municipio = col_character(),
##   link_portal_transp = col_character(),
##   link_prefeitura = col_character(),
##   observacoes = col_character(),
##   fornecedor = col_character(),
##   tipo_fornecer = col_character(),
##   `Fornecedor: Gestões Anteriores` = col_character(),
##   X8 = col_character(),
##   X9 = col_logical(),
##   X10 = col_logical(),
##   X11 = col_logical(),
##   X12 = col_logical(),
##   X13 = col_logical(),
##   X14 = col_logical(),
##   X15 = col_logical(),
##   X16 = col_logical(),
##   X17 = col_logical(),
##   X18 = col_character()
## )

Removendo avaliações que não pertecem ao experimento 01

Para uma avaliação ser considerada válida ela precisa conter 61 itens. Vamos desconsiderar as avaliações que não contém esse número

Vamos remover também o município de Curral de Cima que encontra-se com seu portal de transparência fora do ar.

resultados_avaliacoes_exp01 <- resultados_avaliacoes_exp01 %>% 
  filter(tipo_exp == 'all_itens' & municipio != 'Curral de Cima')

Adicionando combinação encontrada em cada município no gabarito

empresas_portais <- empresas_portais %>% 
    select(municipio, fornecedor)

gararito<-left_join(gararito, empresas_portais, by=c("municipio"))

Juntando Avaliações e Gabaritos

# concatena os dois csv o do gabarito e avaliações do crawler
data<-left_join(resultados_avaliacoes_exp01, gararito, by=c("municipio", "item", "criterio"))

Sumarizando as avaliações

sumarise_exp01 <- data %>% 
    group_by(municipio, criterio, item, aproach, date) %>% 
    mutate(
           
           #verifica se a avaliação foi acertiva
           tp = (valid == TRUE 
           & valid == encontrado 
           #valida se no gabarito e na avaliação o item foi encontrado na mesma url 
           & (grepl(local_encontrado, pathSought) |
                  grepl(local_encontrado_2, pathSought))) | (valid == FALSE 
           & valid == encontrado),
           
           fn =  valid == FALSE 
           & encontrado == TRUE,
           
           fp = valid == TRUE 
           & encontrado == FALSE
          )

sumarise_exp01 %>%
    datatable(options = list(pageLength = 5),  rownames = FALSE, class = 'cell-border stripe')
## Warning in instance$preRenderHook(instance): It seems your data is too big
## for client-side DataTables. You may consider server-side processing: https://
## rstudio.github.io/DT/server.html

Quantificando métricas

metricas_result_exp01 <- sumarise_exp01 %>% 
    #filter(!is.na(aproach )) %>% 
    group_by(municipio, aproach, date) %>% 
    summarise(
        total_itens = n(),
        tp_total = sum(tp), 
        fn_total = sum(fn),
        fp_total = sum(fp),
        
        #cálculo das métricas 
        recall = tp_total/(tp_total + fn_total),
        precision =  tp_total/(tp_total + fp_total),
        f1_score = (2*(recall*precision))/(recall+precision),
        
        #tempo das avaliações
        median_duration_min = median(durationMin),
        median_duration = median(duration),
        max_duration = max(duration),
        max_durationMin = max(durationMin),
        median_num_access_node = median(contNodeNumberAccess),
        max_num_access_node = max(contNodeNumberAccess),
        all_access_node = sum(contNodeNumberAccess),
        combination = last(fornecedor),
        tipo_exp = last(tipo_exp)
    )


metricas_result_exp01 <- metricas_result_exp01 %>%
  filter(total_itens == 61)

metricas_result_exp01 %>% 
    write_csv(here::here("data/resultados_sumarizado_exp01.csv"))

metricas_result_exp01 %>%
  arrange(desc(recall))
## # A tibble: 188 x 19
## # Groups:   municipio, aproach [86]
##    municipio aproach date                total_itens tp_total fn_total fp_total
##    <chr>     <chr>   <dttm>                    <int>    <int>    <int>    <int>
##  1 Campina … bfs     2019-11-09 23:00:06          61       57        0        4
##  2 Campina … dfs     2019-11-13 03:48:50          61       56        0        4
##  3 Alcantil  bandit  2019-12-01 21:04:58          61       57        1        3
##  4 Alcantil  dfs     2019-11-22 15:33:46          61       57        1        3
##  5 Alcantil  dfs     2019-11-30 03:37:54          61       57        1        3
##  6 Cruz do … bandit  2019-11-19 03:30:36          61       57        1        3
##  7 Cruz do … bandit  2019-11-29 04:37:19          61       57        1        3
##  8 Cruz do … bandit  2019-12-01 21:43:44          61       57        1        3
##  9 Cruz do … dfs     2019-11-23 02:52:17          61       57        1        3
## 10 Cruz do … dfs     2019-11-26 18:06:55          61       57        1        3
## # … with 178 more rows, and 12 more variables: recall <dbl>, precision <dbl>,
## #   f1_score <dbl>, median_duration_min <dbl>, median_duration <dbl>,
## #   max_duration <dbl>, max_durationMin <dbl>, median_num_access_node <dbl>,
## #   max_num_access_node <dbl>, all_access_node <dbl>, combination <chr>,
## #   tipo_exp <chr>

Avaliações por abordagem

metricas_result_exp01 %>%
    group_by(aproach) %>% 
    summarise(ocorrencia = n()) %>%
    ggplot(aes(y=ocorrencia, x=reorder(aproach, +(ocorrencia)))) + 
    geom_bar(stat = "identity",  fill="#5499C7") + 
    ggtitle("Número de Avaliações por Abordagem") +
    xlab("Abordagem") + 
    ylab("Número de avaliações") +
    coord_flip()

Número de Avaliações por abordagem

metricas_result_exp01 %>%
    group_by(municipio) %>%
    summarise(bfs = sum(aproach == 'bfs'), dfs = sum(aproach == 'dfs'), bandit = sum(aproach == 'bandit')) %>%
    arrange(desc(dfs)) %>%
    datatable(options = list(pageLength = 10),  rownames = FALSE, class = 'cell-border stripe')

Todas as Avaliações

metricas_result_exp01 %>%
    select(municipio, aproach, date, recall, precision, f1_score) %>%
    arrange(desc(recall)) %>% 
    datatable(options = list(pageLength = 10),  rownames = FALSE, class = 'cell-border stripe')

F1-score

metricas_result_exp01 %>% 
  ggplot(aes(x = aproach, y = f1_score)) +
  geom_boxplot() 

metricas_result_exp01 %>%
    ggplot(aes(x = reorder(aproach, +(f1_score)), y = f1_score)) +
    geom_boxplot() +
    geom_beeswarm(alpha = 0.5, beeswarmArgs=list(side=1))
## Warning: Ignoring unknown parameters: beeswarmArgs

metricas_result_exp01 %>%
  ggplot(aes(aproach, f1_score, color=aproach)) + geom_beeswarm(alpha = 0.5, beeswarmArgs=list(side=1))
## Warning: Ignoring unknown parameters: beeswarmArgs

# median( (metricas_result_exp01 %>% filter(aproach=='bandit'))$f1_score)
# [1] 0.9107143
# [1] 0.9107143
# [1] 0.9009009

vamos verificar os outlies

metricas_result_exp01 %>% filter(f1_score < 0.75) %>%
  select(municipio, aproach, date, f1_score, max_durationMin)  %>%
  ggplot(aes( x=aproach, y=f1_score, color=municipio))+
  geom_jitter()

metricas_result_exp01 %>%
  filter(municipio == 'Barra de Santa Rosa') %>%
  select(municipio, aproach, date, f1_score, max_durationMin)
## # A tibble: 4 x 5
## # Groups:   municipio, aproach [3]
##   municipio           aproach date                f1_score max_durationMin
##   <chr>               <chr>   <dttm>                 <dbl>           <dbl>
## 1 Barra de Santa Rosa bandit  2019-11-27 17:24:57    0.860             222
## 2 Barra de Santa Rosa bfs     2019-11-20 18:15:11    0.870             195
## 3 Barra de Santa Rosa dfs     2019-11-25 19:31:26    0.849             199
## 4 Barra de Santa Rosa dfs     2019-11-26 15:26:04    0.849             212
metricas_result_exp01 %>%
  filter(municipio == 'Conceição') %>%
  select(municipio, aproach, date, f1_score, max_durationMin)
## # A tibble: 4 x 5
## # Groups:   municipio, aproach [2]
##   municipio aproach date                f1_score max_durationMin
##   <chr>     <chr>   <dttm>                 <dbl>           <dbl>
## 1 Conceição bandit  2019-11-21 16:57:54    0.884             539
## 2 Conceição bandit  2019-11-29 03:01:50    0.836             152
## 3 Conceição dfs     2019-11-25 19:29:47    0.860             686
## 4 Conceição dfs     2019-11-30 04:25:25    0.896             657
metricas_result_exp01 %>%
  filter(municipio == 'Remígio') %>%
  select(municipio, aproach, date, f1_score, max_durationMin)
## # A tibble: 5 x 5
## # Groups:   municipio, aproach [3]
##   municipio aproach date                f1_score max_durationMin
##   <chr>     <chr>   <dttm>                 <dbl>           <dbl>
## 1 Remígio   bandit  2019-11-21 04:07:21    0.957              54
## 2 Remígio   bandit  2019-11-28 21:21:46    0.702              87
## 3 Remígio   bfs     2019-11-13 15:33:59    0.957              29
## 4 Remígio   bfs     2019-11-28 04:54:53    0.957              17
## 5 Remígio   dfs     2019-11-28 18:17:59    0.702             108

Tempo de Duração

metricas_result_exp01 %>%
    ggplot(aes(x = reorder(aproach, +(max_durationMin)), y = max_durationMin)) +
    geom_boxplot()

Nós Acessados

metricas_result_exp01 %>%
  ggplot(aes(x = reorder(aproach, +(max_num_access_node)), y = max_num_access_node)) +
  geom_boxplot()

IC

#Calcula a media das posições escolhidas nas buscas.
set.seed(123)

f1_score_boot <- function (d, i) {
    dt<-d[i,]
    c(
          median(dt$f1_score)
    )
}

boot.aproach_exp01 <- metricas_result_exp01 %>%
  group_by(aproach) %>% 
  mutate(cors_boot = list(
      boot(
          data = metricas_result_exp01, 
          statistic = f1_score_boot, 
          R = 4000
          )
      )
     )

ics.aproach_exp01 <- boot.aproach_exp01 %>% 
    group_by(aproach) %>% 
    summarise(
        median_value = median(f1_score),
        ci = list(tidy(cors_boot[[1]], 
          conf.level = .95,
          conf.method = "bca",
          conf.int = TRUE))
        
    ) %>% 
    unnest(ci) 

  
ics.aproach_exp01 %>%  
  ggplot() + 
  geom_errorbar(aes(x = aproach, y = statistic, ymin = conf.low, ymax = conf.high), width = 0.05) +
  geom_point(aes(x=aproach, y=median_value), color='red', size=3) 
## Warning: Ignoring unknown aesthetics: y

Vamos analisar as Combinações

metricas_result_exp01 %>%
ggplot() +
  geom_boxplot(aes(x=combination, y=f1_score), fill = "white")  +
  geom_point(alpha = 0.4, aes(x=combination, y=f1_score, color=aproach), position = "jitter") +
  coord_flip()

metricas_result_exp01 %>%
ggplot() +
  geom_boxplot(aes(x=combination, y=max_num_access_node), fill = "white")  +
  geom_point(alpha = 0.4, aes(x=combination, y=max_num_access_node, color=aproach), position = "jitter") +
  coord_flip()

metricas_result_exp01 %>%
ggplot() +
  geom_boxplot(aes(x=combination, y=max_durationMin), fill = "white")  +
  geom_point(alpha = 0.4, aes(x=combination, y=max_durationMin, color=aproach), position = "jitter") +
  coord_flip()